home *** CD-ROM | disk | FTP | other *** search
/ Scene 96 / Scene 96 International Edition (Zyklop Software) (Disc 2) (1997).iso / misc / coding / pump_src / setup / setup.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1995-10-26  |  13.1 KB  |  475 lines
  1. {$M 4096,0,32768}
  2. {$X+}
  3.  
  4.    (* Copyright by Jare/Iguana in 1993, but given to the public domain. *)
  5.    (* Want more comments? Write'em!                                     *)
  6.  
  7.    (*   Main program. Does too many things not taken to separate units, *)
  8.    (* but anyway it works.                                              *)
  9.  
  10. USES
  11.    DOS,
  12.    Devices, EMS, Menus, Output, Detections, Gfx, HexConversions, Reader, LibFile;
  13.  
  14. CONST
  15.   MainFile='PUMP.EXE';
  16.   VtoFileSpec='C:\PUMP.VTO';
  17.  
  18. VAR
  19.    cfg : TCfg;
  20.    RunForever : BOOLEAN;
  21.    CLine:String;
  22.    Port,DMA,IRQ,Freq:String[5];
  23.    Ofs:String[20];
  24.    Param:String[10];
  25.    P:Char;
  26.    Pags:Word;
  27.  
  28.  
  29. CONST
  30.    rateit : ARRAY [1..13] OF TMenuIt = (
  31.          (Text: ' 8000       486/25        '  ; Val: 8000),
  32.          (Text: '10000          ·          '  ; Val:10000),
  33.          (Text: '12000          ·          '  ; Val:12000),
  34.          (Text: '14000          ·          '  ; Val:14000),
  35.          (Text: '16000          ·          '  ; Val:16000),
  36.          (Text: '18000          ·          '  ; Val:18000),
  37.          (Text: '20000          ·          '  ; Val:20000),
  38.          (Text: '22000       486/50        '  ; Val:22000),
  39.          (Text: '26000          ·          '  ; Val:26000),
  40.          (Text: '32000          ·          '  ; Val:32000),
  41.          (Text: '38000          ·          '  ; Val:38000),
  42.          (Text: '44000  Pentium or higher  '  ; Val:44000),
  43.          (Text: '  Accept previous selection' ; Val:$FFFF)
  44.    );
  45.  
  46. Procedure ShowFreeMem;
  47. Var Mem:Word;
  48. Begin
  49.   asm
  50.     mov ah,48h
  51.     mov bx,0ffffh
  52.     int 21h
  53.     mov Mem,bx
  54.   end;
  55.   Writeln('You have ', mem, ' paragraphs free.');
  56. End;
  57.  
  58. PROCEDURE ChooseRate;
  59.   VAR
  60.      ch : WORD;
  61.      i  : INTEGER;
  62.   BEGIN
  63.      IF (cfg.SoundDevice = NONE) OR (cfg.SoundDevice = GUS) THEN
  64.         EXIT;
  65.      ClearArea;
  66.      ClearMenu(mm^);
  67.      FOR i := 1 TO 13 DO
  68.         AddItem(mm^, rateit[i], TRUE);
  69.      ch := DoMenu(mm^, cfg.ReplayRate);
  70.      IF ch <> $FFFF THEN
  71.         cfg.ReplayRate := ch;
  72.      ClearArea
  73.   END;
  74.  
  75.  
  76. CONST
  77.    devit : ARRAY [1..9] OF TMenuIt = (
  78.         (Text:' Stereo SoundBlaster 16 ASP'; Val:ORD(S_SB16ASP)),
  79.         (Text:'  Mono SoundBlaster 16 ASP'  ; Val:ORD(M_SB16ASP)),
  80.         (Text:'  Stereo SoundBlaster Pro'   ; Val:ORD(S_SBPRO)),
  81.         (Text:'   Mono SoundBlaster Pro'     ; Val:ORD(M_SBPRO)),
  82.         (Text:'    Plain SoundBlaster'        ; Val:ORD(SB)),
  83.         (Text:'     Gravis Ultrasound'         ; Val:ORD(GUS)),
  84.         (Text:'  PAS (SB emulation, sorry)' ; Val:ORD(PAS)),
  85.         (Text:'         No Sound'                  ; Val:ORD(NONE)),
  86.         (Text:'  Accept previous selection'; Val:$FFFF)
  87.    );
  88. PROCEDURE SelectDevice;
  89.   CONST
  90.      compareDevices: ARRAY [TDevices] OF BYTE = (
  91.         0, 0, 0, 0, 0,
  92.         1,
  93.         0,
  94.         2,
  95.         255);
  96.   VAR
  97.      ch : WORD;
  98.      i  : INTEGER;
  99.   BEGIN
  100.      ClearArea;
  101.      ClearMenu(mm^);
  102.      FOR i := 1 TO 9 DO
  103.         AddItem(mm^, devit[i], TRUE);
  104.      ch := DoMenu(mm^, ORD(cfg.SoundDevice));
  105.      IF ch <> $FFFF THEN BEGIN
  106.         IF (cfg.SoundDevice >= DEV_INVALID) OR
  107.            (compareDevices[TDevices(ch)] <> compareDevices[cfg.SoundDevice]) THEN BEGIN
  108.            cfg.SoundDevice := TDevices(ch);
  109.            CASE compareDevices[TDevices(ch)] OF
  110.               0: BEGIN
  111.                     cfg.Port := $220;
  112.                     cfg.IRQ  := 7;
  113.                     cfg.DMA  := 1;
  114.                     DetectSoundEnvironment(cfg)
  115.                  END;
  116.               1: BEGIN
  117.                     cfg.Port := $240;
  118.                     cfg.IRQ  := 11;
  119.                     DetectSoundEnvironment(cfg)
  120.                  END;
  121.               2: BEGIN
  122.                     cfg.Port := $3F8;
  123.                     cfg.IRQ  := 4
  124.                  END
  125.            END
  126.         END;
  127.         cfg.SoundDevice := TDevices(ch);
  128.      END;
  129.      ClearArea
  130.   END;
  131.  
  132.  
  133. PROCEDURE SetPort;
  134.   CONST
  135.      silencePorts: ARRAY [1..4] OF TMenuIt = (
  136.         (Text:'   3F8h (Serial Port COM1)'; Val:$3F8),
  137.         (Text:'   2F8h (Serial Port COM2)'; Val:$2F8),
  138.         (Text:'   3E8h (Serial Port COM3)'; Val:$3E8),
  139.         (Text:'   2E8h (Serial Port COM4)'; Val:$2E8)
  140.      );
  141.   VAR
  142.      portit: TMenuIt;
  143.      ch : WORD;
  144.      i  : INTEGER;
  145.   BEGIN
  146.      IF cfg.SoundDevice > NONE THEN
  147.         EXIT;
  148.      ClearArea;
  149.      ClearMenu(mm^);
  150.      IF cfg.SoundDevice = NONE THEN BEGIN
  151.         FOR i := 1 TO 4 DO
  152.            AddItem(mm^, silencePorts[i], TRUE);
  153.         AddItem(mm^, rateit[13], TRUE)
  154.      END ELSE BEGIN
  155.         FOR i := 1 TO 12 DO BEGIN
  156.            portit.Text := '      Port number 2'+HexByte((i-1)*16)+'h';
  157.            portit.Val  := (i-1)*16 + $200;
  158.            AddItem(mm^, portit, TRUE);
  159.         END;
  160.         AddItem(mm^, rateit[13], TRUE)
  161.      END;
  162.      ch := DoMenu(mm^, cfg.Port);
  163.      IF ch <> $FFFF THEN BEGIN
  164.         cfg.Port := ch;
  165.         IF cfg.SoundDevice = NONE THEN
  166.            IF cfg.Port = $3F8 THEN
  167.               cfg.IRQ := 4
  168.            ELSE IF cfg.Port = $2F8 THEN
  169.               cfg.IRQ := 3
  170.      END;
  171.      ClearArea;
  172.   END;
  173.  
  174.  
  175. PROCEDURE SetIRQ;
  176.   VAR
  177.      irqit : TMenuIt;
  178.      ch    : WORD;
  179.      i     : INTEGER;
  180.      s     : STRING;
  181.   BEGIN
  182.      IF cfg.SoundDevice > NONE THEN
  183.         EXIT;
  184.      ClearArea;
  185.      ClearMenu(mm^);
  186.      FOR i := 2 TO 15 DO
  187.         IF (i <> 6) AND (i <> 9) THEN BEGIN
  188.            Str(i : 2, s);
  189.            irqit.Text := '        IRQ number '+s;
  190.            irqit.Val  := i;
  191.            AddItem(mm^, irqit, TRUE)
  192.         END;
  193.      AddItem(mm^, rateit[13], TRUE);
  194.      ch := DoMenu(mm^, cfg.IRQ);
  195.      IF ch <> $FFFF THEN
  196.         cfg.IRQ := ch;
  197.      ClearArea;
  198.   END;
  199.  
  200. PROCEDURE SetDMA;
  201.   VAR
  202.      dmait : TMenuIt;
  203.      ch    : WORD;
  204.      i     : INTEGER;
  205.      s     : STRING;
  206.   BEGIN
  207.      IF (cfg.SoundDevice >= NONE) OR (cfg.SoundDevice = GUS) THEN
  208.         EXIT;
  209.      ClearArea;
  210.      ClearMenu(mm^);
  211.      FOR i := 0 TO 7 DO
  212.         IF (i <> 2) AND (i <> 4) THEN BEGIN
  213.            Str(i : 2, s);
  214.            dmait.Text := '       DMA channel '+s;
  215.            dmait.Val  := i;
  216.            AddItem(mm^, dmait, TRUE)
  217.         END;
  218.      AddItem(mm^, rateit[13], TRUE);
  219.      ch := DoMenu(mm^, cfg.DMA);
  220.      IF ch <> $FFFF THEN
  221.         cfg.DMA := ch;
  222.      ClearArea;
  223.   END;
  224.  
  225. FUNCTION Cfg2Text: STRING;
  226.   VAR
  227.      s1, s2 : STRING;
  228.   BEGIN
  229.      s1 := {'Device: '+}devit[ORD(cfg.SoundDevice)+1].Text;
  230.      IF cfg.SoundDevice <> NONE THEN BEGIN
  231.         s1 := s1;
  232.         IF cfg.SoundDevice <> GUS THEN BEGIN
  233.            Str(cfg.ReplayRate, s2);
  234.            s1 := s1 + ', Rate = ' + s2
  235.         END;
  236.         s1 := s1 + ', Port ' + HexWord(cfg.Port) + 'h, IRQ ';
  237.         Str(cfg.IRQ, s2);
  238.         s1 := s1 + s2;
  239.         IF cfg.SoundDevice <> GUS THEN BEGIN
  240.            Str(cfg.DMA, s2);
  241.            s1 := s1 + ', DMA ' + s2
  242.         END
  243.      END ELSE BEGIN
  244.         IF (cfg.Port = $3F8) AND (cfg.IRQ = 4) THEN
  245.            s1 := s1 + ' (COM1)'
  246.         ELSE IF (cfg.Port = $3F8) AND (cfg.IRQ = 4) THEN
  247.            s1 := s1 + ' (COM1)'
  248.         ELSE IF (cfg.Port = $2F8) AND (cfg.IRQ = 3) THEN
  249.            s1 := s1 + ' (COM2)'
  250.         ELSE IF (cfg.Port = $3E8) AND (cfg.IRQ = 4) THEN
  251.            s1 := s1 + ' (COM3)'
  252.         ELSE IF (cfg.Port = $2E8) AND (cfg.IRQ = 3) THEN
  253.            s1 := s1 + ' (COM4)'
  254.         ELSE BEGIN
  255.            s1 := s1 + ', Serial Port ' + HexWord(cfg.Port) + 'h, IRQ ';
  256.            Str(cfg.IRQ, s2);
  257.            s1 := s1 + s2
  258.         END
  259.      END;
  260.      Cfg2Text := s1
  261.   END;
  262.  
  263.  
  264. CONST
  265.    mainit : ARRAY [1..8] OF TMenuIt = (
  266.          (Text:'        Run the demo'; Val:0),
  267.          (Text:'    Select sound device'; Val:1),
  268.          (Text:'    Choose sampling rate'; Val:2),
  269.          (Text:'      Set port number'; Val:3),
  270.          (Text:'          Set IRQ'; Val:4),
  271.          (Text:'      Set DMA channel'; Val:5),
  272.          (Text:'     Notes of interest'; Val:6),
  273.          (Text:'        Exit to DOS'; Val:$FFFF)
  274.    );
  275. PROCEDURE MainMenu;
  276.   VAR
  277.      ch : WORD;
  278.      i  : INTEGER;
  279.      uopts : ARRAY [1..8] OF BOOLEAN;
  280.   BEGIN
  281.      ch := 0;
  282.      FOR i := 1 TO 8 DO
  283.        uopts[i] := TRUE;
  284.      IF cfg.SoundDevice = DEV_INVALID THEN BEGIN
  285.         cfg.SoundDevice := NONE;
  286.         SelectDevice;
  287.         IF cfg.SoundDevice <> NONE THEN BEGIN
  288.            IF cfg.SoundDevice = GUS THEN BEGIN
  289.               cfg.DMA  :=   1;  {Not used}
  290.               cfg.IRQ  :=   7;
  291.               cfg.Port := $220;
  292.               cfg.ReplayRate := 44000; {WOW!}
  293.            END ELSE BEGIN
  294.               cfg.DMA  :=    1;  {Not used}
  295.               cfg.IRQ  :=    7;
  296.               cfg.Port := $220;
  297.               cfg.ReplayRate := 16000; {WOW!}
  298.            END;
  299.            ChooseRate;
  300.            SetPort;
  301.            SetIRQ;
  302.            SetDMA;
  303.         END
  304.      END;
  305.      REPEAT
  306.         DumpDevice(CFG2Text);
  307.         ClearMenu(mm^);
  308.         uopts[3] := NOT((cfg.SoundDevice = NONE) OR (cfg.SoundDevice = GUS));
  309.         uopts[6] := NOT((cfg.SoundDevice = NONE) OR (cfg.SoundDevice = GUS));
  310.         FOR i := 1 TO 8 DO
  311.            AddItem(mm^, mainit[i], uopts[i]);
  312.         ch := DoMenu(mm^, ch);
  313.         CASE ch OF
  314.            0 : RunForever := FALSE;
  315.            1 : SelectDevice;
  316.            2 : ChooseRate;
  317.            3 : SetPort;
  318.            4 : SetIRQ;
  319.            5 : SetDMA;
  320.            6 : ReadText;
  321.            $FFFF : BEGIN EndScreen; HALT(1); END;
  322.         END;
  323.      UNTIL (ch = 0) OR (ch = 7);
  324.   END;
  325.  
  326.  
  327.  
  328. TYPE
  329. TS = ARRAY[1..4000] OF BYTE;
  330. VAR
  331. SSS : TS ABSOLUTE $B800:0;
  332. f   : FILE OF TS;
  333. VAR
  334.    fcfg : FILE OF TCfg;
  335.    fvto : TEXT;
  336.    i, j : INTEGER;
  337.    s    : STRING;
  338.  
  339. CONST
  340.    VTDevs : ARRAY [TDevices] OF STRING = (
  341.          'DMA-SB-Stereo',
  342.          'DMA-SB-Mono',
  343.          'DMA-SB-Stereo',
  344.          'DMA-SB-Mono',
  345.          'DMA-SB-Mono',
  346.          'GUS',
  347.          'DMA-SB-Mono',
  348.          'Silence',
  349.          'Silence'    (* If you don't know which card, then no card. *)
  350.    );
  351.  
  352. BEGIN
  353.    {ShowFreeMem;}
  354.    CheckFilesOK;
  355.    cfg.SoundDevice := DEV_INVALID;
  356.    cfg.ReplayRate  := 16000;
  357.    cfg.IRQ  := 7;  (* Something to use as default values. *)
  358.    cfg.DMA  := 1;
  359.    cfg.Port := $220;
  360.    cfg.visco:= 2;
  361.    DetectSoundEnvironment(cfg);
  362.  
  363.    i := IOResult;
  364.  
  365.    IF NOT IsVGA THEN BEGIN
  366.       WriteLn(#13'                                              ');
  367.       WriteLn('I think you don''t have the required VGA card.');
  368.       Write(' Continue anyway? (y/N) ');
  369.       IF UpCase(CHAR(GetKey)) <> 'Y' THEN BEGIN
  370.          WriteLn;
  371.          WriteLn('Go buy a cool ET-4000 or something like that.');
  372.          HALT(1)
  373.       END
  374.     End;
  375.  
  376.     IF NOT Is386 THEN BEGIN
  377.        WriteLn(#13'                                              ');
  378.        WriteLn('I can''t find a 386SX or higher in your machine. I need one.');
  379.        Write(' Continue anyway? (y/N) ');
  380.        IF UpCase(CHAR(GetKey)) <> 'Y' THEN BEGIN
  381.           WriteLn;
  382.           WriteLn('Have a sad DOS (without a 386 it sure will be).');
  383.           HALT(1)
  384.        END
  385.     END;
  386.  
  387.     ASM
  388.       MOV  AX,3
  389.       INT  10h
  390.     END;
  391.  
  392.  
  393.     InitScreen;
  394.     SplitIn;
  395.  
  396.  
  397.     asm
  398.       mov dx,03d4h
  399.       mov al,0ah
  400.       out dx,al
  401.       inc dx
  402.       in al,dx
  403.       and al,224
  404.       or al,20h
  405.       out dx,al
  406.     end;
  407.  
  408.     MainMenu;
  409.     SplitOut;
  410.     EndScreen;
  411.     asm
  412.       mov dx,03d4h
  413.       mov al,0ah
  414.       out dx,al
  415.       inc dx
  416.       in al,dx
  417.       and al,224
  418.       or al,20h
  419.       out dx,al
  420.     end;
  421.  
  422.  
  423.       IF ((cfg.SoundDevice = NONE) AND HasMouse) (*OR IsProtMode*) THEN BEGIN
  424.  
  425.          IF IsProtMode THEN BEGIN
  426.             WriteLn('You are running in protected mode (EMM386, QEMM, Windows, OS/2, DesqView).'#13#10,
  427.                     'If the demo runs slow or flickers, try booting with a clean MSDOS.'#13#10);
  428.          END;
  429.  
  430.          IF (cfg.SoundDevice = NONE) AND HasMouse THEN BEGIN
  431.             WriteLn('You have selected silent mode, but your mouse driver may cause conflicts.');
  432.             WriteLn('If you experience any problems, try changing the COM port and IRQ.');
  433.          END;
  434.          Write(' Press any key to continue');
  435.          GetKey;
  436.          WriteLn(#13'                                              ');
  437.       END;
  438.  
  439.    If (cfg.SoundDevice<>GUS) then Begin
  440.      If not EMM_Installed then Begin
  441.         Writeln('You need to have at least 512 Kb EMS memory');
  442.         Halt(1);
  443.      End;
  444.      asm
  445.        mov pags,0
  446.        mov ah,42h
  447.        int 67h
  448.        mov pags,bx
  449.      end;
  450.      If LongInt(pags*16)<512 then Begin
  451.         Writeln('You need to have at least 512 Kb EMS memory');
  452.         Halt(1);
  453.      End;
  454.    End;
  455.    Str(cfg.Port,Port);
  456.    Str(cfg.IRQ,IRQ);
  457.    Str(cfg.DMA,DMA);
  458.    Str(cfg.ReplayRate,Freq);
  459.  
  460.    Cline:=' /nb /v:127 /port:'+Port+' /irq:'+IRQ;
  461.    IF NOT (cfg.SoundDevice IN [NONE, GUS]) THEN BEGIN
  462.       Cline:=Cline+' /dma:'+DMA+' /d:'+VTDevs[cfg.SoundDevice]+' /f:'+Freq;
  463.    END ELSE
  464.       Cline:=Cline+' /d:'+VTDevs[cfg.SoundDevice];
  465.  
  466.    Str(LF_FindFile('THE_SIGN.S3M')^.offs,ofs);
  467.    CLine:=' '+MainFile+' '+CLine+' /off:'+ofs+' /sh:PUMP.DAT ';
  468.    (* Escribir VTO *)
  469.    Assign(fvto, VtoFileSpec);
  470.    Rewrite(fvto);
  471.    Write(fvto, CLine);
  472.    Close(fvto)
  473. END.
  474.  
  475.